home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pctj8307.arc / BOXES.BAS next >
BASIC Source File  |  1984-01-23  |  2KB  |  76 lines
  1. 1000 'File: BOXES.BAS
  2. 1010 'Auth: Thomas V. Hoffmann
  3. 1020 'Edit: TVH  18-April-83  6:00pm
  4. 1030 '
  5. 1040 DEFINT A-Z
  6. 1050 '----------
  7. 1060 'CGA Definitions
  8. 1070 '
  9. 1080 MODEREG = &H3D8: COLORREG = &H3D9   '-- CGA Control Registers
  10. 1090 MODESAVE = &H465: COLORSAVE = &H466 '-- BIOS Saves CGA Regs here
  11. 1100 CRTREG = &H3D4: CRTDATA = &H3D5     '-- 6845 CRT control regs
  12. 1110 HIRES=1: GRAPH=2: BW=4: VIDEO=8     '-- Mode register bits
  13. 1120 G640=16: BLINK=32                   '-- ..
  14. 1130 '
  15. 1140 '----------
  16. 1150 ' Switch to Color Adapter
  17. 1160 '   (If no mono adapter installed,
  18. 1170 '   change 1 to 0 in next line)
  19. 1180 '
  20. 1190 MONO = 1   '-- Return to mono adapter
  21. 1200 GOSUB 7000
  22. 1210 '
  23. 1220 '----------
  24. 1230 ' Set F10 for Exit
  25. 1240 '
  26. 1250 KEY ON: KEY (10) ON
  27. 1270 ON KEY(10) GOSUB 9900
  28. 1280 '
  29. 1290 '----------
  30. 1300 'Select 640 Color Mode
  31. 1310 '
  32. 1320 SCREEN 2: KEY OFF: CLS
  33. 1330 DEF SEG=0
  34. 1340 MODE = PEEK (MODESAVE) AND NOT BW
  35. 1350 POKE MODESAVE,MODE: OUT MODEREG,MODE
  36. 1360 '
  37. 3000 '----------
  38. 3010 ' Repeat Random 40x20 Boxes, PAINTed With Color
  39. 3020 '
  40. 3030 WHILE 1
  41. 3040 '-- Generate Random (X,Y) for Upper Left Corner
  42. 3050     X=RND*640: Y=RND*200
  43. 3060 '-- Draw White Box Outline
  44. 3070     LINE  (X,Y)-STEP (40,20),1,B
  45. 3080 '-- Draw Nested Box Filled in Black
  46. 3090     LINE (X+1,Y+1)-STEP(38,18),0,BF
  47. 3100 '-- Pick Next Color Pattern in Sequence
  48. 3110     C = (C+1) MOD 15
  49. 3120     IF C = 0 THEN GOTO 3150 '-- Can't PAINT pattern 0
  50. 3130 '-- Paint Box with Color Pattern
  51. 3140     PAINT (X+3,Y+3),CHR$(C*&H11)
  52. 3150 WEND
  53. 3160 '
  54. 3170 '----------
  55. 7000 '----------
  56. 7010 ' Switch to Color/Graphics Display
  57. 7020 '
  58. 7030 DEF SEG=0: A=PEEK(&H410): POKE &H410,(A AND &HCF) OR &H20
  59. 7040 WIDTH 40: SCREEN 1: SCREEN 0: LOCATE ,,1,6,7
  60. 7050 RETURN
  61. 7060 '
  62. 7100 '----------
  63. 7110 ' Conditionally Switch to Monochrome Display
  64. 7120 '
  65. 7130 IF MONO <> 1 THEN LOCATE 1,1: RETURN
  66. 7140 DEF SEG=0: A=PEEK(&H410): POKE &H410,(A OR &H30)
  67. 7150 WIDTH 80: LOCATE ,,1,12,13: SCREEN 0,0,0
  68. 7160 KEY ON
  69. 7170 RETURN
  70. 7180 '
  71. 9900 '----------
  72. 9910 ' F10 Gets Here to Exit
  73. 9920 '
  74. 9930 GOSUB 7100 '-- return to monochrome
  75. 9940 END        '-- and quit
  76.